www.gusucode.com > HCONLY站长管理助手 V1.3 > HCONLY站长管理助手 V1.3\code\tools\wordreplace.asp
<!--#include file="../config/chkAdmin.asp"-->
<%
dim realname:realname="wordreplace.asp" '★程序真实文件名,默认为wordreplace.asp,用于屏蔽替换程序中的字符
dim realpath:realpath=server.mappath(".")&"\"&realname
dim enname:enname="WordreplaceV1.0"
dim myname:myname="Wordreplace在线文本批量替换工具V1.0"
dim myinfo:myinfo="能自动识别文件编码类型，在线批量替换文本文件中的字符的asp原创程序."
dim exename:exename="txt,asp,js,css,htm,html,xml,xsl,php,jsp" '★替换文件后缀类型,多个以,分隔
dim exename2
dim fso:set fso=Server.CreateObject("Scripting.FileSystemObject")
dim url:url=request.servervariables("url")
dim cset
dim text1,text2,shu,okshu
shu=0
okshu=0
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title><%=myname%>-<%=myinfo%></title>
<style>
body{padding:0;margin:10px;background-color:#DBE2EA;margin-left:100px;margin-right:100px;font-size:13px;font-family:Georgia;}
a{color:#ff6600;text-decoration:none;}
p{margin:8px;padding:0;}
#juice{color:#ff6600;}
form{margin:0;padding:0;}
#main{}
#main a{color:#000;text-decoration:none;}
#btn{height:25px;padding:4px;border:1px solid #666;background:#eee;color:#666;}
#title{height:25px;text-align:center;font-size:15px;font-weight:bold;}
#info{padding:10px;}
#copy{padding:5px;text-align:center;}
#copy p{margin:3px;padding:0;}
</style>
</head>
<body>
<div id=main>
<%
dim g:g=request.querystring("g")
select case g
case "replace" replacetext()
case "search" searchtext()
case else choose()
end select
%>
</div>
</body>
</html>
<%
function choose()
say"<form name=frm method=POST action=?g=replace>"
say"<p><input type=checkbox value=1 name=chkreself>替换时不排除本程序 "
say"<input type=checkbox value=1 name=chkallfolder checked>包含所有子目录 "
say"<input type=checkbox value=1 name=chkbig checked>忽略大小写</p>"
say"<p>请选择替换目录：<input type=text name='path' size=55 value='"&server.mappath(".")&"'></p>"
say"<p>文件输出目录：<input type=text name='path2' size=55 value='"&server.mappath(".")&"_out'></p>"
say"<p>替换文件类型：<input type=text name='exename2' size=55 value='"&exename&"'></p>"
say"<p>查找字符：<textarea name=text1 cols=70 rows=5></textarea></p>"
say"<p>替换字符：<textarea name=text2 cols=70 rows=5></textarea></p>"
say"<p align=center><input id=btn type=submit value='开始替换'> <input id=btn type=submit onclick=""frm.action='?g=search'"" value='搜索查找'></p>"
say"</form>"
end function
function searchtext()
session("search")=true
session("chkallfolder")=request.form("chkallfolder")
session("chkbig")=request.form("chkbig")
session("chkreself")=request.form("chkreself")
exename2=request.form("exename2")
if right(exename2,1)<>"," then exename2=exename2&","
session("exename2")=exename2
path1=request.form("path")
path=request.form("path")&"\"
path2=request.form("path2")
say "<p>字符搜索-文件列表：</p>"
text1=request.form("text1")
if session("chkbig")=1 then text1=lcase(text1)
text2=request.form("text2")
dim chk
showfolder(path1&"\")
showfile(path1)
say "<p>搜索结果:找到了<font color=#ff6600>"&okshu&"</font>个 / 共<font color=#ff6600>"&shu&"</font>个文件 "
say " <a href='javascript:history.back()'><font color=#ff6600>返回</font></a></p>"
end function
function replacetext()
session("chkallfolder")=request.form("chkallfolder")
session("chkbig")=request.form("chkbig")
session("chkreself")=request.form("chkreself")
exename2=request.form("exename2")
if right(exename2,1)<>"," then exename2=exename2&","
session("exename2")=exename2
path1=request.form("path")
path=request.form("path")&"\"
path2=request.form("path2")
fso.copyfolder Path1,path2
say "<p>文件输出目录："&path2&"</p>"
say "<p>字符替换-文件列表：</p>"
text1=request.form("text1")
if session("chkbig")=1 then text1=lcase(text1)
text2=request.form("text2")
dim chk
showfolder(path2&"\")
showfile(path2)
say "<p>替换了<font color=#ff6600>"&okshu&"</font>个 / 共<font color=#ff6600>"&shu&"</font>个文件 "
say " <a href='javascript:history.back()'><font color=#ff6600>返回</font></a></p>"
end function
sub showfolder(path)
Set Root1 = Fso.GetFolder(path)
For Each f1 In Root1.subfolders
if session("chkallfolder")=1 then showfolder(path&f1.name&"\")
showfile(path&f1.name)
next
end sub
sub showfile(path)
Set Root2 = Fso.GetFolder(path)
For Each f2 In Root2.files
say"<p>"
file=path&"\"&f2.name
if session("chkreself")<>1 and file=realpath then
say "<b>×</b> <a target=_blank title='"&file&"' href='"&href&"'>"&f2.name&"</a> ★程序自身★"
else
exe1=f2.name&"."
exe2=split(exe1,".")
exe=exe2(ubound(exe2)-1)
if checkexe(exe)=true then
a=len(replace(url,f2.name,""))
b=len(url)
href=server.mappath("\")
href=replace(file,href,"")
texta=LoadFromFile(file)
text=texta
if session("chkbig")=1 then text=lcase(text)
textb=replace(text,text1,text2)
if textb<>text then
say "<b>√</b> "
okshu=okshu+1
if session("search")<>true then call SaveToFile(textb,file)
else
say "<b>×</b> "
end if
say "<a target=_blank title='"&file&"' href='"&href&"'>"&f2.name&"</a> "
if checkexe(exe)=true then
say"编码："&session("cset")
if file=realpath then say" ★程序自身★"
else
say"文件类型不附"
end if
else
say "<b>×</b> "
end if
end if
say"</p>"
shu=shu+1
next
end sub
function checkexe(exe)
checkexe=false
chkexe=session("exename2")
chkexe=split(chkexe,",")
for i=0 to ubound(chkexe)-1
if exe=chkexe(i) then checkexe=true:exit for
next
end function
Function LoadFromFile(ByVal File)
dim cset
Dim objStream
dim a1,b1,c1,a2,b2,c2
Dim RText
RText = Array(0, "")
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = 2
.Mode = 3
.Open
.charset = "unicode"
.Position = objStream.Size
.LoadFromFile File
RTexta = Array(0, .ReadText)
a2=len(RTexta(1))
a1=objStream.Size
.Close
End With
With objStream
.Type = 2
.Mode = 3
.Open
.Position = objStream.Size
.charset = "utf-8"
.LoadFromFile File
RTextb = Array(0, .ReadText)
b2=len(RTextb(1))
b1=objStream.Size
.Close
End With
With objStream
.Type = 2
.Mode = 3
.Open
.Position = objStream.Size
.charset = "gb2312"
.LoadFromFile File
RTextc = Array(0, .ReadText)
c2=len(RTextc(1))
c1=objStream.Size
.Close
End With
if a1<b1 then
if a1<c1 then csettext=RTexta:cset="unicode"
if a1<=c1 then
if a2<c2 then csettext=RTexta:cset="unicode"
end if
end if
if b1<a1 then
if b1<c1 then csettext=RTextb:cset="utf-8"
if b1<=c1 then
if b2<c2 then csettext=RTextb:cset="utf-8"
end if
end if
if c1<a1 then
if c1<b1 then csettext=RTextc:cset="gb2312"
if c1<=b1 then
if c2<b2 then csettext=RTextc:cset="gb2312"
end if
end if
session("cset")=cset
LoadFromFile = csettext(1)
Set objStream = Nothing
End Function
Function SaveToFile(strBody,File)
Dim objStream
Dim RText
RText = Array(0, "")
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = 2
.Open
.Charset = session("cset")
.Position = objStream.Size
.WriteText = strBody
On Error Resume Next
.SaveToFile File, 2
If Err Then
RText = Array(Err.Number, Err.Description)
SaveToFile = RText
Err.Clear
Exit Function
End If
.Close
End With
RText = Array(0, "保存文件成功!")
SaveToFile = RText
Set objStream = Nothing
End Function
function say(str)
response.write str
end function
%>